home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.10 / demo / sparky.p < prev    next >
Text File  |  1995-04-19  |  13KB  |  638 lines
  1. program Sparky;
  2.  
  3. { ****************************************************************************
  4.  
  5.             Sparky, V 1.1, (C) 1993 by Diesel
  6.  
  7.   **************************************************************************** }
  8.  
  9. {$I "Include:intuition/screens.i"}
  10. {$I "Include:intuition/intuition.i"}
  11. {$I "Include:graphics/view.i"}
  12. {$I "Include:graphics/pens.i"}
  13. {$I "Include:graphics/text.i"}
  14. {$I "Include:exec/libraries.i"}
  15. {$I "Include:libraries/dos.i"}
  16. {$I "Include:libraries/medplayer.i"}
  17. {$I "Include:utils/stringlib.i"}
  18. {  $I "Include:" }
  19.  
  20. {$I "sparx:vdx.i"}
  21. {$I "sparx:vd1.i"}
  22. {$I "sparx:vd5.i"}
  23. {$I "sparx:vd6.i"}
  24. {$I "sparx:vd7.i"}
  25.  
  26. {$I "sparx:pic.i"}
  27.  
  28.  
  29. Const
  30.     lz : String = "   ";
  31.  
  32.     MaxColors = 32;
  33.     MaxLines  = 32;
  34.  
  35.     NS : NewScreen = (0,0,320,256, 5, 0,0, 0,
  36.               CustomScreen_f, NIL,NIL,NIL,NIL );
  37.  
  38.  
  39. VAR
  40.     ActualSpot : Short;
  41.     ColCnt       : Short;
  42.  
  43. Type
  44.  
  45.     Spot = Record
  46.       x,y  : Short;
  47.     End;
  48.  
  49.     Line = Record
  50.       x1,y1,
  51.       x2,y2  : Short;
  52.     End;
  53.     LinePtr = ^Line;
  54.  
  55.     LineArray    = Array[1..MaxLines] of Line;
  56.     LineArrayPtr = ^LineArray;
  57.  
  58.     ColorArray    = Array[0..MaxColors-1] of Short;
  59.     ColorArrayPtr = ^ColorArray;
  60.  
  61.     SinCosArray    = Array[0..680] of Short;    { 628 + Reserve }
  62.     SinCosArrayPtr = ^SinCosArray;
  63.  
  64.  
  65. Const
  66.     Def_Colors : ColorArray = ($0000, $0fff, $0f00, $0f30,
  67.                    $0f60, $0f90, $0fc0, $0ff0,
  68.                    $0cf0, $09f0, $06f0, $03f0,
  69.                    $00f0, $00f3, $00f6, $00f9,
  70.                    $00fc, $00ff, $00cf, $009f,
  71.                    $006f, $003f, $000f, $030f,
  72.                    $060f, $090f, $0c0f, $0f0f,
  73.                    $0f0c, $0f09, $0f06, $0f03);
  74.  
  75.     GreenMap   : ColorArray = ($0000, $0f00, $0040, $0080,
  76.                    $00a0, $00b0, $00a0, $0080,
  77.                    $0040, $0044, $0088, $00aa,
  78.                    $00bb, $00aa, $0088, $0044,
  79.                    $0440, $0880, $0aa0, $0bb0,
  80.                    $0aa0, $0880, $0440, $0400,
  81.                    $0800, $0a00, $0b00, $0c00,
  82.                    $0b00, $0a00, $0800, $0400);
  83.  
  84. Var
  85.     GfxBase : Address;
  86.  
  87.     Xsin,
  88.     XCos : SinCosArrayPtr;
  89.     flt  : Real;
  90.     i    : Integer;
  91.  
  92.     Work32cols : ColorArrayPtr;
  93.  
  94.  
  95.     VP     : ViewPortPtr;
  96.     VW     : ViewPtr;
  97.     RP     : RastPortPtr;
  98.     WB,
  99.     Scr    : ScreenPtr;
  100.     module : MMD0Ptr;
  101.  
  102.  
  103. { -------------------------------------------- }
  104.  
  105. Function InitSong: Boolean;
  106. Var
  107.   void : Integer;
  108. Begin
  109.     MEDPlayerBase := OpenLibrary( medname, 0 );
  110.     if MEDPlayerBase = NIL  then InitSong:=False;
  111.  
  112.     module := NIL;
  113.     void := GetPlayer(0);
  114.  
  115.     if void = 0 then begin
  116.       module := LoadModule("Purity 10:MEDPlayerLibrary/med.turning(avatar)");
  117.       If module <> NIL then Begin
  118.         PlayModule(module);
  119.         Delay(50);
  120.         InitSong:=True;
  121.       End Else
  122.         InitSong:=False;
  123.     end else InitSong:=False;
  124.  
  125. End;    { InitSong }
  126.  
  127. { -------------------------------------------- }
  128.  
  129.  
  130. Procedure ShutUp;
  131. Begin
  132.     If Scr <> NIL then  CloseScreen( Scr );
  133.  
  134.     If WB <> NIL then begin
  135.       For i := 1 to WB^.height do
  136.         MoveScreen( WB, 0, -1 );
  137.     end;
  138.  
  139.  
  140.     If module<>NIL then Begin
  141.       DimOffPlayer(12);
  142.       Delay(100);
  143.       UnLoadModule(module);
  144.       FreePlayer;
  145.     End;
  146.  
  147.     If (MEDPlayerBase <> NIL) then CloseLibrary(MEDPlayerBase);
  148.     If (IFFBase <> NIL) then CloseLibrary(IffBase);
  149.     If (VecBase <> NIL) then CloseLibrary(VecBase);
  150.     If (GfxBase <> NIL) then CloseLibrary(GfxBase);
  151.  
  152. end;    { ShutUp }
  153.  
  154.  
  155.  
  156. { -------------------------------------------- }
  157.  
  158.  
  159. Function dff006 : Short;
  160. Begin
  161. {$A
  162.     move.w    $dff006,d0
  163.  
  164. }
  165. End;
  166.  
  167.  
  168.  
  169. Function LeftMouseButton : Boolean;
  170. Begin
  171. {$A
  172.     moveq    #0,d0
  173.     btst    #6,$bfe001
  174.     bne.s    notpressed
  175. pressed:
  176.     moveq    #-1,d0
  177.  
  178. notpressed:
  179.  
  180. }
  181. end;
  182.  
  183.  
  184. Procedure ClrScr;
  185. Begin
  186.     Move(RP, 0,0);
  187.     ClearScreen( RP );
  188. End;
  189.  
  190.  
  191. Procedure SetSColors(clarr : Address);
  192.  
  193. Begin
  194.     LoadRGB4( VP, clarr, maxColors );
  195.  
  196.     MakeVPort( VW, VP);
  197.     MrgCop( VW );
  198.     LoadView( VW );
  199.  
  200. End;
  201.  
  202.  
  203.  
  204. Procedure Colorsdown;
  205. Var
  206.     cnn   : ColorArrayPtr;
  207.     r,g,b,
  208.     i,j,
  209.     rest  : Short;
  210.  
  211. Begin
  212.     New( cnn );
  213.  
  214.     For i:= 0 to maxColors-1 do
  215.       cnn^[i] := Short( GetRGB4( VP^.ColorMap, i ));
  216.  
  217.     For i:=0 to 15  do Begin
  218.  
  219.       For j:=0 to MaxColors-1 do Begin
  220.         rest := cnn^[j];
  221.         b := rest MOD 16;        { In Asm wird natürlich }
  222.         rest := rest DIV 16;    { einfach nur um 4 bits }
  223.         g := rest MOD 16;        { nach rechts geshiftet }
  224.         rest := rest DIV 16;    { .....            }
  225.         r := rest MOD 16;
  226.  
  227.         If r > 0 then dec(r);
  228.         If g > 0 then dec(g);
  229.         If b > 0 then dec(b);
  230.  
  231.         cnn^[j] := (256 * r) + (16 * g) + b;
  232.       End;
  233.  
  234.       SetSColors( cnn );
  235.  
  236.       MakeVPort( VW, VP);
  237.       MrgCop   ( VW );
  238.       LoadView ( VW );    
  239.       Delay(1);            { 1/50 sec. warten = smooth }
  240.     End;
  241.  
  242.     Dispose( cnn);
  243.  
  244. End;
  245.  
  246.  
  247.  
  248. Procedure Ciao;
  249. Begin
  250.     ColorsDown;
  251.     ClrScr;
  252. End;
  253.  
  254.  
  255.  
  256.  
  257.  
  258. Procedure DrawLine( xyz : LinePtr; col : Short );
  259. Begin
  260.     SetAPen( RP, Byte(col) );
  261.     SetDrMd( RP, jam1 );
  262.     Move( RP, xyz^.x1, xyz^.y1 );
  263.     Draw( RP, xyz^.x2, xyz^.y2 );
  264. End;
  265.  
  266.  
  267. Procedure EraseLine( xyz : LinePtr );
  268. Begin
  269.     SetBPen( RP, 0 );
  270.     SetAPen( RP, 0 );
  271.     SetDrMd( RP, jam2 + inversvid );
  272.     Move( RP, xyz^.x1, xyz^.y1 );
  273.     Draw( RP, xyz^.x2, xyz^.y2 );
  274. End;
  275.  
  276. Const
  277.     bang    = 1;
  278.     tipp    = 2;
  279.     fade    = 3;
  280.     fadeUp    = 4;
  281.  
  282. Procedure ShowText( what : String; col, dy, mode : Short);
  283. Var
  284.     x,
  285.     buf,
  286.     cnt : Short;
  287. begin
  288.     x := 160 - 4 * strlen(what);
  289.     SetAPen(RP, Byte(col));
  290.     Move(RP, x, dy);
  291.  
  292. { ---- }
  293.     If mode = bang then
  294.         GText(RP, what, strlen(what) );
  295.  
  296.  
  297. { ---- }
  298.     If (mode = tipp) AND (strlen(What) > 0) then begin
  299.         for cnt:=1 to strlen(what) do begin
  300.           Move(RP, x, dy);
  301.           GText(RP, what, cnt );
  302.           Delay(2);
  303.         end;
  304.       End;
  305.  
  306. { ---- }
  307.     If mode = fade then begin
  308.       SetAPen(RP, 1);
  309.       SetRGB4( VP, 1, 0,0,0);
  310.  
  311.       Delay(2);
  312.       GText(RP, what, strlen(what) );
  313.  
  314.       For cnt := 1 to 15 do begin
  315.         SetRGB4( VP, 1, cnt,cnt,cnt);
  316.         Delay(2);
  317.       End;
  318.  
  319.       Delay(50);
  320.  
  321.       For cnt := 15 downto 0 do begin
  322.         SetRGB4( VP, 1, cnt,cnt,cnt);
  323.         Delay(2);
  324.       End;
  325.  
  326.       ClrScr;
  327.       SetSColors(Adr(Def_Colors));
  328.     End;
  329.  
  330. { ---- }
  331.     If mode = fadeUp then begin
  332.  
  333.       SetRGB4( VP, col, 0,0,0);
  334.       Delay(2);
  335.       GText(RP, what, strlen(what) );
  336.       For cnt := 1 to 15 do begin
  337.         SetRGB4( VP, col, cnt,cnt,cnt);
  338.         Delay(2);
  339.       End;
  340.  
  341.       SetSColors(Adr(Def_Colors));
  342.       Delay(20);
  343.     End;
  344.  
  345. End;
  346.  
  347.  
  348.  
  349.  
  350. { -------------------------------------------------------------------------- }
  351.  
  352.  
  353.  
  354. {$I "sparx:.spark02.i"}
  355. {$I "sparx:.spark03.i"}
  356. {$I "sparx:.spark04.i"}
  357. {$I "sparx:.spark05.i"}
  358. {$I "sparx:.spark06.i"}
  359. {$I "sparx:.spark07.i"}
  360. {$I "sparx:.spark08.i"}
  361. {$I "sparx:.spark09.i"}
  362.  
  363. {$I "sparx:.spark10.i"}
  364. {$I "sparx:.spark11.i"}
  365. {$I "sparx:.spark12.i"}
  366. {$I "sparx:.spark12B.i"}
  367. {$I "sparx:.spark13.i"}
  368. {$I "sparx:.spark16.i"}
  369. {$I "sparx:.spark17.i"}
  370. {$I "sparx:.spark18.i"}
  371. {  $I "sparx:.spark20.i"}
  372. {  $I "sparx:.spark19.i"}
  373.  
  374.  
  375.  
  376.  
  377. Begin
  378.     GfxBase := OpenLibrary ("graphics.library",0);
  379.     If GfxBase = NIL then Exit(20);
  380.  
  381.     VecBase := OpenLibrary(vecname, 0);
  382.     If VecBase = NIL then begin
  383.       Write("Cannot open vector.library\n\nKlick!\n");
  384.       Repeat until LeftMouseButton;
  385.       ShutUp;
  386.     end;
  387.  
  388.     IFFBase := OpenLibrary(IFFNAME,18);    { -- hier reicht 18 -- }
  389.     if IFFBase = NIL then begin
  390.       Write("Cannot open iff.library\n\nKlick!\n");
  391.       Repeat until LeftMouseButton;
  392.       ShutUp;
  393.     end;
  394.  
  395.     WB := OpenWorkbench;
  396.     If WB <> NIL then begin
  397.       For i := 1 to WB^.height do
  398.         MoveScreen( WB, 0, 1 );
  399.     end;
  400.  
  401.  
  402.     New(XSin);
  403.     New(XCos);
  404.     New(Work32cols);
  405.  
  406.     flt := 0.00;
  407.  
  408.     For i:=0 to 680 do Begin
  409.       Xsin^[i] := Short( trunc( 100.0 * Sin( flt ) ));
  410.       XCos^[i] := Short( trunc( 100.0 * Cos( flt ) ));
  411.       flt := flt + 0.01;    { Bei 0.09 Abweichung um 0.01 !!!! }
  412.     end;
  413.  
  414.     Scr := OpenScreen( Adr( NS ));
  415.     If Scr=NIL then ShutUp;
  416.     ShowTitle( Scr, False );
  417.  
  418.     RP := Adr( Scr^.SRastPort );
  419.     VP := Adr( Scr^.SViewPort );
  420.     VW := ViewAddress;
  421.     ClrScr;
  422.     SetSColors(Adr(Def_Colors));    
  423.  
  424.  
  425.     If NOT InitSong then Begin
  426.       ShowText("Sorry - cannot load sound", 0, 100, fade);
  427.     End;
  428.  
  429.  
  430.     ShowText("Klick it !", 3, 120, fadeup);
  431.     Repeat
  432.       Delay(4);
  433.     Until LeftMouseButton;
  434.     ClrScr;
  435.     Delay(10);
  436.     Spark06( Adr(Def_Colors) );
  437.  
  438.  
  439.  
  440.     ShowText("Coded 1993 by Diesel", 0, 120, fade);
  441.     Spark09;
  442.  
  443.     ShowText("Coded 100% in PCQ-Pascal", 11, 60, tipp);
  444.     ShowText("for the  Pascal-FD-Serie", 11, 80, tipp);
  445.     Delay(100);
  446.     ShowText("***  Purity  ***", 2, 120, bang);
  447.     Delay(100);
  448.     ClrScr;
  449.     Spark10;
  450.  
  451.     ShowText("Just a little sparking...      !", 6, 40, tipp);
  452.     Delay(100);
  453.     ClrScr;
  454.     Spark11;
  455.     Spark06( Adr(GreenMap) );
  456.  
  457.  
  458.     ShowText("& Vectors ....", 2, 80, fadeup);
  459.     ClrScr;
  460.     Delay(30);
  461.     ShowText( VD1, 3, 120, bang);            { "alles in pascal" }
  462.     Delay(100);
  463.     ClrScr;
  464.     Spark12;
  465.  
  466.     ShowText("Ursprünglich  erschien   eine",  2,  40, fadeup);
  467.     ShowText("Vorabversion  dieser Demo auf",  3,  60, fadeup);
  468.     ShowText("der *Amiga-User gegen Rechts*",  4,  80, fadeup);
  469.     ShowText("-Disk.  Jetzt findet sie sich",  5, 100, fadeup);
  470.     ShowText("mit  einigen  Änderungen  und",  6, 120, fadeup);
  471.     ShowText("dem kompletten  Quellcode auf",  7, 140, fadeup);
  472.     ShowText("der Purity !  Also Leute, wer",  8, 160, fadeup);
  473.     ShowText("von Euch schreibt die nächste",  9, 180, fadeup);
  474.     ShowText("Demo in Pascal ??            ", 10, 200, fadeup);
  475.     Delay(50);
  476.     ShowText("<klick>                      ", 11, 240, bang);
  477.     Spark12B(27);
  478.     Spark02;
  479.  
  480.     ShowText( "Eat it !", 30, 90, fade);
  481.     ShowText( ShowPix("Purity 10:demo/pic/pacman.ilbm"), 27, 100, fade);
  482.     ClrScr;
  483.  
  484.     ShowText("Die  Vector-Animationen  habe ich", 11,  20, fadeup);
  485.     ShowText("mithilfe der  vector.library ein-", 12,  40, fadeup);
  486.     ShowText("gebunden.  Diese findet sich auch", 13,  60, fadeup);
  487.     ShowText("auf einer unserer ersten Puritys.", 14,  80, fadeup);
  488.     ShowText("Leider konnte  ich bis heute noch", 15, 100, fadeup);
  489.     ShowText("keine Docs zu dieser library auf-", 16, 120, fadeup);
  490.     ShowText("treiben.  Hat jemand von Euch ev.", 17, 140, fadeup);
  491.     ShowText("eine zuhause rumliegen ? Dann her", 18, 160, fadeup);
  492.     ShowText("damit.(Die v.lib kam, glaube ich,", 19, 180, fadeup);
  493.     ShowText("mit der AmigaPlus 11/91.)        ", 20, 200, fadeup);
  494.     Delay(100);
  495.     ShowText("<klick>                          ", 22, 240, bang);
  496.     Spark12B(21);
  497.  
  498.  
  499.     ShowText("Loose your illusions !", 2, 120, bang);
  500.     Delay(50);
  501.     ClrScr;
  502.     Spark03;
  503.     ClrScr;
  504.  
  505.     ShowText( ShowPix("Purity 10:demo/pic/WarDose2.ilbm"), 27, 100, fade);
  506.     ClrScr;
  507.  
  508.     ShowText("Man muß sich heutzutage als", 4, 060, tipp);
  509.     ShowText("Chemiestudent  ja  wirklich", 4, 080, tipp);
  510.     ShowText("schämen, dieser verrotteten", 4, 100, tipp);
  511.     ShowText("Industrie als Kanonenfutter", 4, 120, tipp);
  512.     ShowText("zu dienen.                 ", 4, 140, tipp);
  513.     Delay(50);
  514.     ClrScr;
  515.  
  516.     ShowText("Ratet mal, wer am Main     ", 5, 080, tipp);
  517.     ShowText("am meisten rumsaut ?!?     ", 5, 100, tipp);
  518.     Delay(50);
  519.     ShowText("hoechst wahrscheinlich ....", 6, 140, tipp);
  520.     Delay(50);
  521.     ClrScr;
  522.     Delay(20);
  523.     ShowText( VD5, 8, 140, tipp);
  524.     Delay(100);
  525.     ClrScr;
  526.  
  527.     ShowText( ShowPix("Purity 10:demo/pic/Dose.ilbm"), 27, 100, fade);
  528.     ClrScr;
  529.  
  530.     ShowText("(20-40-160-320 lines ...)", 25, 200, bang);
  531.     Delay(100);
  532.     ClrScr;
  533.     Spark13;
  534.  
  535.  
  536.     Work32Cols^[0] := $0000;
  537.     For i:=1 to MaxColors-1 do
  538.       Work32cols^[i] := i * $0002;
  539.  
  540.     Spark16(Work32Cols);
  541.  
  542.  
  543.  
  544.     ShowText("Warum haben wir eigentlich",    23,  60, bang);
  545.     ShowText("sowenige aktive Programmierer", 23,  80, bang);
  546.     ShowText("im Umkreis der Purity ...?",    23, 100, bang);
  547.     Delay(200);
  548.     ClrScr;
  549.  
  550.     Spark16(Adr(GreenMap));
  551.  
  552.     ShowText( ShowPix("Purity 10:demo/pic/diesel.ilbm"), 27, 100, fade);
  553.     ClrScr;
  554.  
  555.     Spark04;
  556.  
  557.     Delay(30);
  558.     ShowText("Endemoniada", 22,  120, fade );
  559.     ClrScr;
  560.  
  561.     Work32Cols^[0] := $0000;
  562.     For i:=1 to MaxColors-1 do
  563.       Work32cols^[i] := Dff006 MOD 4096;
  564.  
  565.     Spark16(Work32Cols);
  566.  
  567.     ShowText("Der Weltraum,unendliche Weiten...", 2,  40, tipp);
  568.     Delay(50);
  569.     ClrScr;
  570.     Delay(10);
  571.     ShowText( VD7, 29, 200, fade );
  572.     ClrScr;
  573.  
  574.     ShowText("------  Grüße gehen an :  -------", 2,  40, tipp);
  575.     ShowText("Wurzelsepp, Steppenbrand, Feedy, ", 1,  70, tipp);
  576.     ShowText("Kilghard-Wolf, Invisible Power,  ", 1,  90, tipp);
  577.     ShowText("Funny Future, Norbi, Alex(TuC),  ", 1, 110, tipp);
  578.     ShowText("Martin, Martin & Sonja, DoIO,    ", 1, 130, tipp);
  579.     ShowText("Swing, Mozart, Attila, die FreaX ", 1, 150, tipp);
  580.     ShowText("aus der InfoX (Read it !), logo, ", 1, 170, tipp);
  581.     ShowText("und alle, die ich vergessen habe ",10, 190, tipp);
  582.     ShowText("<Klick>                          ",10, 240, tipp);
  583.     Spark12B(8);
  584.  
  585.     Spark17;
  586.     ShowText("Greets 2 the avatar - great muzaX!",10, 190, fade);
  587.     Spark07( Address(0) );
  588.  
  589.     ShowText("Ach, die vector.library arbeitet",   8, 120, bang);
  590.     ShowText("natürlich  auch mit Drahtgittern",   8, 140, bang);
  591.     Delay(100);
  592.     ClrScr;
  593.     Delay(20);
  594.     ShowText( VD6,  8, 140, bang);
  595.     Delay(100);
  596.     ClrScr;
  597.  
  598.     ShowText( "Noch von der Anti-Rechts-Disk:", 14, 100, tipp );
  599.     Delay(70);
  600.     ClrScr;
  601.     ShowText( ShowPix("Purity 10:demo/pic/trottel.ilbm"),   5, 100, fade);
  602.     ClrScr;
  603.  
  604.     Delay(100);
  605.     ClrScr;
  606.     Spark18;
  607.     Spark05;
  608.  
  609.     ShowText("... dead but dreaming", 0, 220, fade);
  610.     Spark07( Adr(Def_Colors) );
  611.  
  612.     ShowText("1 line --klick--> 512 lines", 1, 120, fade);
  613.     Spark08;
  614.     ShowText("Es sind durchaus mehr möglich", 1, 120, fade);
  615.     ShowText("(sieht aber nicht gut aus)", 1, 120, fade);
  616.     Spark16( Address(0) );
  617.  
  618.  
  619.     ShowText("(C)1993 by B. Künnen, 44 MS", 31, 180, tipp);
  620.     Spark12B(15);
  621.  
  622.     Work32Cols^[0] := $0000;
  623.     for i:= 1 to maxcolors-1 do
  624.       Work32cols^[i] := 256 * (Dff006 MOD 16)
  625.                + 16 * (Dff006 MOD 16)
  626.                +      (Dff006 MOD 16);
  627.     Spark07( Work32Cols );
  628.  
  629.     ShowText("Das soll für heute reichen.", 31, 140, fade);
  630.     ShowText("---- Und tschüß ! ----", 31, 140, fade);
  631.  
  632.  
  633.  
  634.     ShutUp;
  635.  
  636. end.
  637.  
  638.